DOpus Plus/DOpus Plus.iso/Enhancements/FTPBatch/ARexx/FTPBatchDownload.dopus5

Text File | 1998-10-25 | 16.1 KB | 544 lines

/* $VER: FTPBatchDownload.dopus 4.1 (25.10.98) (C) by Martin Steigerwald
*/

OPTIONS RESULTS
IF ~SHOW('L','rexxsupport.library') THEN CALL ADDLIB('rexxsupport.library',0,-30,0)

PARSE ARG opus listerport handle defaultmaxconnections config.requesters ' "' config.logging '" ' '"' destdir '" ' whichentries deletemode

opus=STRIP(opus)
listerport=STRIP(listerport)
handle=STRIP(handle)
defaultmaxconnections=STRIP(defaultmaxconnections)
config.requesters=STRIP(config.requesters)
whichentries=STRIP(whichentries)
deletemode=STRIP(deletemode)

/* --- DELAY ---
   Here you can specify how long, in 1/50 seconds, FTPBatchDownload should
   wait when all FTP listers are busy.
   I recommend: Don't go below 25.
   Raise this value when FTPBatchDownload eats to much CPU time on your system.
*/

config.delay=25

ADDRESS VALUE opus

IF handle=0 | listerport=0 THEN DO
    Request('"ERROR: No batch lister given!" OK')
END

portnr=SUBSTR(listerport, POS('.',listerport)+1)
appname='FTPBatchDownload'
portname=appname'.'portnr
lf='0a'X
debugging=0 /* debuginfo? 2=annoy console device 1=low 0=none */
listermode=2 /* open ftp listers iconified? 2=invisible 1=iconofied 0=full */

IF ~OPENPORT(portname) THEN DO
    DOPUSREQUEST '"'appname': Couldnt open port" OK'
    EXIT
END

/* OPTIONS FAILAT 11    */

nr=1

AddLog('')
AddLog('STATUS: Started FTPBatchDownload.')

DO FOREVER

    /* busy mode & lister closed? */
    LISTER QUERY handle PATH
    IF RC=10 THEN DO
        LEAVE
    END

    /* collectentries */

    CollectEntries()

    LISTER SET handle BUSY OFF
    IF deletemode='AUTODOWNLOAD' THEN DO
        LISTER QUERY handle PATH
        IF RC=0 THEN DO
            LISTER CLOSE handle
        END
    END

    /* batchdownloadsystem(TM) ;-) */

    /* something to download? */
    IF entries>0 THEN DO
        /* not more connections than entries */
        IF defaultmaxconnections>entries THEN DO
            maxconnections=entries
        END
        ELSE DO
            maxconnections=defaultmaxconnections
        END
        IF maxconnections=1 THEN DO
            returncode=DownloadOneByOne()
            /* leave script when returncode=0 */
            IF returncode=0 THEN entries=0
        END
        ELSE DO
            returncode=DownloadThemAllAtOnce() /* ;-) */
            /* leave loop when returncode=0 */
            IF returncode=0 THEN entries=0
        END /* ELSE maxconnections */
    END /* IF entries */

    IF entries=0 | deletemode~=='DELETEENTRIES' | whichentries~='ALL' THEN DO
        LEAVE
    END

END /* DO FOREVER */

CLOSEPORT(portname)



EXIT

/**************************/
/* DownloadThemAllAtOnce  */
/**************************/

DownloadThemAllAtOnce:

    /* Open all FTP listers */
    success=OpenAllFTPListers()
    returncode=1

    IF success=1 THEN DO
        ec=0 ; lc=0 /* entrycounter, listercounter */

        /* download loop */
        DO FOREVER
            /* are all listers ready with their work? */
            ready=AllFTPListersReady()
            /* a lister is closed! */
            IF ready='closed' THEN DO
                returncode=0
                Request('"ERROR: A FTP lister has been closed. Exiting" OK')
                LEAVE
            END

            /* are we done? */
            IF ready=1 & ec>=entries THEN LEAVE /* YES! ;-) */

            /* check for the next free lister */
            lc=CheckNextFreeFTPLister()
            /* a lister is closed! */
            IF lc='closed' THEN DO
                returncode=0
                Request('"ERROR: A FTP lister has been closed. Exiting" OK')
                LEAVE
            END

            /* whats going on, lister? */
            LISTER QUERY ftphandle.lc VALUE 'status'
            status=RESULT

            IF config.requesters=='QUIET' THEN DO
                'COMMAND WAIT SOURCE' ftphandle.lc 'FTPSetVar Quiet ON'
            END

            /* downloaded something? */
            IF status=='download' THEN DO
                success=AfterDownload()
                IF success=0 THEN returncode=0
                IF success='abort' THEN DO
                    returncode=0
                    LEAVE
                END
            END
            /* correct directory set? */
            ELSE IF status='currentdir' THEN DO
                StartDownload()
            END
            /* already connected? */
            ELSE IF status='connect' THEN DO
                SetCurrentDir()
            END
            /* preparing new download */
            ELSE IF ec<entries THEN DO
                success=NewDownload()
                IF success=0 THEN returncode=0
                IF success='abort' THEN DO
                    returncode=0
                    LEAVE
                END
            END
        END /* DO download loop*/

    END

    /* clean up */
    DO i=1 TO maxconnections
        IF ftphandle.i ~= 0 THEN LISTER CLOSE ftphandle.i
    END
RETURN returncode

OpenAllFTPListers:
    success=1
    DO i=1 TO maxconnections
        ftphandle.i=0
    END
    DO i=1 TO maxconnections
        IF listermode=0 THEN LISTER NEW
        IF listermode=1 THEN LISTER NEW ICONIFY
        IF listermode=2 THEN LISTER NEW INVISIBLE
        ftphandle.i=RESULT
        IF ftphandle.i=0 THEN DO
            Request('"ERROR: Couldnt open new lister for ftp!" OK')
            success=0
            LEAVE
        END
        LISTER WAIT ftphandle.i QUICK
        LISTER SET ftphandle.i TITLE appname'.'i
        LISTER SET ftphandle.i VALUE 'status' 'new'
        LISTER QUERY ftphandle.i VALUE 'ftpsite' '///'
        LISTER QUERY ftphandle.i VALUE 'srcpathname' '///'

        LISTER REFRESH ftphandle.i FULL
        IF config.requesters=='QUIET' THEN DO
         /*   LISTER SET ftphandle.i SOURCE */
            'COMMAND WAIT SOURCE' ftphandle.i 'FTPSetVar Quiet 1'
         /*   LISTER SET ftphandle.i OFF */
        END
    END /* DO maxconnections */
RETURN success

AllFTPListersReady:
    ready=1
    DO lccheck=1 TO maxconnections
        LISTER QUERY ftphandle.lccheck VALUE 'status'
        IF RC=10 THEN DO
            ready='closed'
            LEAVE
        END
        IF RESULT~='ready' THEN DO
            ready=0
        END
        IF debugging>=2 THEN DO
            SAY 'STATUS   status:' RESULT 'lister:' lccheck 'entrycounter:' ec
        END
    END /* DO are all ready? */
RETURN ready

CheckNextFreeFTPLister:
    closedlisters=0 ; allclosed=0
    lastlc=lc
    DO FOREVER
        lc=lc+1
        IF lc>maxconnections THEN lc=1

        LISTER QUERY ftphandle.lc BUSY

        IF RESULT=0 THEN LEAVE
        IF lc=lastlc THEN DO
            IF debugging>=1 THEN DO
                SAY 'DELAY    lister:' lc
            END
            DELAY(config.delay) /* dont overuse CPU power, no busy loop ;-) */
        END
        /* lister closed? */
        IF RC=10 THEN DO
            lc='closed'
            LEAVE
        END /* IF lister closed? */
    END /* check for next free lister */
RETURN lc

AfterDownload:
    LISTER WAIT ftphandle.lc QUICK
    success_afterdownload=1
    LISTER QUERY ftphandle.lc VALUE 'entry'
    actentry=RESULT
    IF debugging>=1 THEN DO
        SAY 'READY    lister:' lc 'ftpsite:' ftpsite 'downloaded entry:' entry.actentry.name
    END
    achar=RIGHT(destdir,1)
    IF achar~==':' & achar~=='/' THEN DO
        destfile=destdir'/'entry.actentry.name
    END
    ELSE DO
        destfile=destdir || entry.actentry.name
    END

    IF ~EXISTS(destfile) THEN DO
        success_afterdownload=0
        AddLog('ERROR: Can not find local file »destfile«!')
        abort=DownloadFailed(entry.actentry.name)
        IF abort=0 THEN success_afterdownload='abort'
    END
    commentstr=WORD(STATEF(destfile),8)
    IF UPPER(LEFT(commentstr,16))=='TRANSFER ABORTED' THEN DO
        success_afterdownload=0
        Addlog('ERROR: Found »Transfer Aborted» in comment of »'destfile'«')
        abort=DownloadFailed(entry.actentry.name)
        IF abort=0 THEN success_afterdownload='abort'
    END

    IF actentry~=0 & deletemode='DELETEENTRIES' THEN DO
        IF success_afterdownload=1 THEN DO
            LISTER QUERY handle PATH
            IF RC=0 THEN DO
                'COMMAND WAIT SOURCE' handle ' DELETE "'entry.actentry.name'"'
            END
        END
    END
    AddLog('STATUS: #'lc 'Successfully downloaded entry »'entry.actentry.name'«.')
    LISTER SET ftphandle.lc VALUE 'status' 'ready'
RETURN success_afterdownload

StartDownload:
    LISTER WAIT ftphandle.lc QUICK
    LISTER QUERY ftphandle.lc VALUE 'entry'
    actentry=RESULT
    splitok=SplitURL(entry.actentry.comment)
    /* we don't URL check here. It has been checked in StartDownload
       already. */
    destfilename=entry.actentry.name
    LISTER SET ftphandle.lc VALUE 'status' 'download'
    IF debugging>=1 THEN DO
        SAY 'DOWNLOAD lister:' lc 'ftpsite:' ftpsite 'entry:' entry.actentry.name
    END
    AddLog('STATUS: #'lc 'Downloading entry »'entry.actentry.name'«.')
    'COMMAND SOURCE' ftphandle.lc 'COPYAS NAME="'srcfilename'" NEWNAME="'destfilename'" TO="'destdir'" QUIET'
RETURN 1

SetCurrentDir:
    LISTER WAIT ftphandle.lc QUICK
    LISTER QUERY ftphandle.lc VALUE 'srcpathname'
    srcpathname=RESULT
    LISTER QUERY ftphandle.lc VALUE 'oldsrcpathname'
    oldsrcpathname=RESULT
    IF srcpathname~==oldsrcpathname THEN DO
        IF debugging>=1 THEN DO
            SAY 'CWD      lister:' lc 'ftpsite:' ftpsite 'path:' srcpathname
        END
        'COMMAND SOURCE' ftphandle.lc 'FTPCOMMAND QUIET CWD' srcpathname
    END
    LISTER SET ftphandle.lc VALUE 'status' 'currentdir'
RETURN 1

NewDownload:
    LISTER WAIT ftphandle.lc QUICK
    success_newdownload=1
    ec=ec+1
    LISTER QUERY ftphandle.lc VALUE 'ftpsite'
    oldftpsite=RESULT
    LISTER QUERY ftphandle.lc VALUE 'srcpathname'
    oldsrcpathname=RESULT
    LISTER SET ftphandle.lc VALUE 'oldsrcpathname' oldsrcpathname
    splitok=SplitURL(entry.ec.comment)
    IF splitok=0 THEN DO
        Request('"ERROR: Wrong URL »'entry.ec.comment'«!" OK')
        success_newdownload=0
        abort=DownloadFailed(entry.ec.name)
        IF abort=0 THEN success_newdownload='abort'
    END
    ELSE DO
        LISTER SET ftphandle.lc VALUE 'status' 'connect'
        LISTER SET ftphandle.lc VALUE 'entry' ec
        LISTER SET ftphandle.lc VALUE 'ftpsite' ftpsite
        LISTER SET ftphandle.lc VALUE 'srcpathname' srcpathname

        IF ftpsite~==oldftpsite THEN DO /* new connect? */
            IF debugging>=1 THEN DO
                SAY 'CONNECT  lister:' lc 'ftpsite:' ftpsite 'entry:' entry.ec.name 'oldftpsite:' oldftpsite
            END
            AddLog('STATUS: #'lc 'Connecting to »'ftpsite'«.')
            'COMMAND FTPCONNECT LISTER ' ftphandle.lc 'HOST' ftpsite 'NOSCAN'
        END /* IF new connect? */
    END
RETURN success_newdownload

/****************************/
/* Download them one by one */
/****************************/

DownloadOneByOne:
    /* open lister */
    returncode=1
    IF listermode=0 THEN LISTER NEW
    IF listermode=1 THEN LISTER NEW ICONIFY
    IF listermode=2 THEN LISTER NEW INVISIBLE
    ftphandle=RESULT
    IF ftphandle=0 THEN DO
       Request('"ERROR: Couldnt open new lister for ftp!" OK')
       returncode=0
    END
    IF ftphandle~=0 THEN DO
        LISTER WAIT ftphandle QUICK
        LISTER SET ftphandle TITLE appname
        LISTER REFRESH ftphandle FULL

        ftpsite='///'
        srcpathname='///'

        /* download loop */
        DO i=1 TO entries
            LISTER QUERY ftphandle PATH
            IF RC=10 THEN DO
                SAY "YES!"
                Request('"ERROR: The FTP lister has been closed!" OK')
                returncode=0
                LEAVE
            END

            oldftpsite=ftpsite
            oldsrcpathname=srcpathname
            splitok=SplitURL(entry.i.comment)
            IF splitok=0 THEN DO
                Request('"ERROR: Wrong URL »'entry.i.comment'«!" OK')
                returncode=0
            END
            ELSE DO
                destfilename=entry.i.name
                IF config.requesters=='QUIET' THEN DO
                    'COMMAND WAIT SOURCE' ftphandle 'FTPSetVar Quiet 1'
                END

                IF oldftpsite~==ftpsite THEN DO
                    AddLog('STATUS: Connecting to »'ftpsite'«.')
                    'COMMAND WAIT FTPCONNECT LISTER ' ftphandle 'HOST' ftpsite 'DIR "'srcpathname'" NOSCAN'
                END
                IF config.requesters=='QUIET' THEN DO
                    'COMMAND WAIT SOURCE' ftphandle 'FTPSetVar Quiet 1'
                END

                IF oldsrcpathname~==srcpathname THEN DO
                    'COMMAND WAIT SOURCE' ftphandle 'FTPCOMMAND QUIET CWD' srcpathname
                END
                AddLog('STATUS: Downloading entry »'entry.i.name'«.')
                'COMMAND WAIT SOURCE' ftphandle 'COPYAS NAME="'srcfilename'" NEWNAME="'destfilename'" TO="'destdir'" QUIET'
                copyok=RESULT
                IF copyok=0 THEN DO
                    returncode=0
                    abort=DownloadFailed(entry.i.name)
                    IF abort=0 THEN LEAVE
                END
                IF copyok=1 & deletemode=='DELETEENTRIES' THEN DO
                    LISTER QUERY handle PATH
                    IF RC=0 THEN DO
                        'COMMAND WAIT SOURCE' handle ' DELETE "'entry.i.name'"'
                    END
                END
                IF copyok=1 THEN DO
                    AddLog('STATUS: Successfully downloaded entry »'entry.i.name'«.')
                END
            END
        END
        LISTER CLOSE ftphandle
    END
RETURN returncode

/***************/
/* Other stuff */
/***************/

DownloadFailed: PROCEDURE EXPOSE config. lf
    PARSE ARG file
    abort=1
    returncode=Request('"ERROR: Failed to download entry »'file'«!" OK|Abort')
    IF returncode=0 THEN DO
        abort=0
    END
RETURN abort

Request: PROCEDURE EXPOSE config.
    PARSE ARG string
    IF config.logging~=='' THEN DO
        PARSE VAR string '"' errortext '"'
        AddLog(errortext)
        returncode=1
    END
    IF config.requesters='REQUESTERS' THEN DO
        DOPUS REQUEST string
        returncode=RC
    END
RETURN returncode


AddLog: PROCEDURE EXPOSE config.logging
    PARSE ARG string
    IF config.logging~=='' THEN DO
        IF EXISTS(config.logging'.log') THEN DO
            res=OPEN('fh', config.logging'.log', 'APPEND')
        END
        ELSE DO
            res=OPEN('fh', config.logging'.log', 'WRITE')
        END
        IF res=res THEN DO
            IF string='' THEN DO
                WRITELN('fh', '')
            END
            ELSE DO
                IF POS(':',string)>0 & POS(':',string)<=7 THEN DO
                    PARSE VAR string before ':' after
                    string=before || ':' || COPIES(' ', 6-LENGTH(before)) || after
                END
                WRITELN('fh', DATE()' 'TIME()' - 'string)
            END
            CLOSE('fh')
        END
    END
RETURN 1

/* splits URL into srcfilename, srcpathname and ftpsite */
SplitURL: PROCEDURE EXPOSE srcfilename srcpathname ftpsite
    PARSE ARG url
    success=1
    sep1=POS('//', url)
    sep2=LASTPOS('/', url)
    IF sep1~=0 & sep2~=0 & sep2-sep1-2>0 THEN DO
        srcfilename=SUBSTR(url, sep2+1)
        srcpathname=SUBSTR(url, sep1+2, sep2-sep1-2)
        IF POS(':',srcpathname)=0 THEN DO
            srcpathname='/'srcpathname
        END
        ftpsite=LEFT(url, sep1-1)
    END
    ELSE DO
        success=0
    END
RETURN success


CollectEntries:
    LISTER SET handle BUSY ON
    entries=0
    IF whichentries='ALL' THEN DO
        LISTER QUERY handle NUMENTRIES
        entries=RESULT
        /* something left? */
        IF entries>0 THEN DO
            DO i=1 TO entries
                LISTER QUERY handle ENTRY '#' || i-1 STEM entry.i.
            END
        END /* IF something left? */
    END
    ELSE IF whichentries='SELECTED' THEN DO
        LISTER QUERY handle SELFILES STEM selectfiles.
        entries=selectfiles.count
        /* something selected? */
        IF entries>0 THEN DO
            DO i=1 TO entries
                j=i-1
                LISTER QUERY handle ENTRY '"'selectfiles.j'"' STEM entry.i.
            END
        END
        ELSE DO
            LISTER REQUEST handle '"You didnt select anything!" OK'
        END
    END /* IF whichentries */
    LISTER SET handle BUSY OFF
RETURN 0